<%
'******************************************************************************************
'#          Openasp CMS software opensource                                               #
'******************************************************************************************
'#      Copyright (C) Luca Becchetti, Broken Ice Interactive                              #
'#                                                                                        #
'# Questo software è gratuito, è possibile ridistribuire e modificare il prodotto         #
'# rispettando i termini della GNU General Public License pubblicata dalla Free           #
'# Software Foundation, si fa riferimento alla versione attuale e a tutte le versioni.    #
'# future                                                                                 #
'#                                                                                        #
'# Il software viene distribuito con lo scopo di essere utile e di aiutare nella          #
'# realizzazione di un sito web, non ci assiumiamo nessuna responsabilità per             #
'# eventuali malfunzionamenti o problemi provenienti dal programma.                       #
'#                                                                                        #
'# E' assolutamente vietato eliminare ogni riferimento di copyright sia all'interno del   #
'# del codice sorgente sia quelli visivi nel progetto.                                    #
'#                                                                                        #
'# Una copia della licenza GNU GPL è rilasciata nel pacchetto di istallazione del         #
'# software.                                                                              #
'#                                                                                        #
'# Per supporto visita il nostro sito ufficiale                                           #
'# http://www.openasp.it                                                                  #
'#                                                                                        #
'#                                                                                        #
'******************************************************************************************
'
' La funzione è molto semplice. legge il contenuto del file da includere usando il filesystem object.
' Dopo di che rimuove i delimtatori ASP < % ... % >. Questo consente di poter riutilizzare il file.
' Il contenuto rimanente del file viene passato alla procedura vb "ExecuteGlobal".
' Questo includerà il codice nel processo corrente permettendoci di utilizzarlo.
'
' Per la base dello script si ringrazia l'eccellente lavoro di	: Don Selkirk
' Per le modofiche e la correzzione di bug si ringrazia		: Michael Tanczos
' Per l'adattamento della classe al motore openasp si ringrazia	: Luca Becchetti
'
' Dichiarazione variabili e costanti pubbbliche per la classe
  Public incFile
  Public include_vars
  Public include_vars_count
  Dim	 objfschk
  
  set incFile 	= new cls_include
  set objfschk 	= server.createobject("scripting.filesystemobject")
  set regFltr 	= new regexp
  set regFltr2 	= new regexp

  sub printerr(titolo, desc)
  Response.Clear()
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<title>Errore di sistema</title>
<style type="text/css">
@charset "UTF-8";
/* CSS Document */

body{
	margin:0;
	padding:0;
	font-size:100.01%;
	font-family:"Trebuchet MS", Geneva, Arial, Helvetica, sans-serif;
	background:#4a4e4f;
	text-align:center;
}

#container{
	margin:100px auto;
	text-align:left;
	height:350px;
	width:500px;
	background:url(themes/share/errore.jpg) center no-repeat;
}

#container h1{
	color:#FFFFFF;
	padding-top:50px;
	margin-left:170px;
	margin-right:40px;
	font-size:130%;
	border-bottom:dotted 1px;
}

div#err{
	color:#FFFFFF;
	margin-left:170px;
	margin-right:40px;
	font-size:12px;
}

div#small{
	color:#CCCCCC;
	font-size:9px;
	position:fixed;
	bottom:0;
	text-align:center;
	width:100%;
	padding:3px;
	left:0;
}

div#small a{
	color:#CCCCCC;
	font-size:9px;
	border-bottom: 1px #CCCCCC dotted;
	text-align:center;
}
</style>
</head>

<body>
<div id="container">
<h1><%=titolo%></h1>
<div id="err"><%=desc%></div>
</div>
<br />
<div id="small"><a href="http://www.openasp.it">Openasp</a> free software GNU/GPL License</div>
</body>
</html>
<%
  Response.End()
  end sub
  
'Inizializzazione della classe di inclusione  
  class cls_include

    private sub class_initialize()
      set include_vars = server.createobject("scripting.dictionary")
	  include_vars_count = 0
    end sub
    private sub class_deactivate()
      include_vars.removeall
      set include_vars = nothing
      set include = nothing
    end sub

    public default function incFile(byval str_path)
      dim str_source
      if str_path <> "" then
	  
	  	if (instr(str_path,":") > 0) then
			init_path = str_path
		else
			init_path = server.mappath(str_path)
		end if	
		
        str_source = readfile(str_path)
        if str_source <> "" then
          str_source = processincludes (str_source, init_path, 0)
          convert2code str_source
          formatcode str_source
          if str_source <> "" then
	  	On error resume next
		executeglobal str_source
		'Comunico l'errore e interrompo tutti i processi
		if err > 0 then
			response.Write "<div style=""border: 1px #000000 solid; background-color: #ffffff""><p class='errore'>errore inclusione dinamica, processo terminato<br />"
			response.Write "errore: " & err.description 
			response.Write "<br />numero: " & err.number
			response.Write "<br />file: " & str_path
			response.Write "</p></div>"
			response.End()
		end if
            end if
        end if
      end if
    end function

    private sub convert2code(str_source)
      dim i, str_temp, arr_temp, int_len, basecount
	  basecount = include_vars_count
      if str_source <> "" then
        if instr(str_source,"%" & ">") > instr(str_source,"<" & "%") then
          str_temp = replace(str_source,"<" & "%","¿%")
          str_temp = replace(str_temp,"%" & ">","¿")
          if left(str_temp,1) = "¿" then str_temp = right(str_temp,len(str_temp) - 1)
          if right(str_temp,1) = "¿" then str_temp = left(str_temp,len(str_temp) - 1)
          arr_temp = split(str_temp,"¿")
          int_len = ubound(arr_temp)
          if (int_len + 1) > 0 then
            for i = 0 to int_len
              str_temp = arr_temp(i)
              str_temp = replace(str_temp,vbcrlf & vbcrlf,vbcrlf)
              if left(str_temp,2) = vbcrlf then str_temp = right(str_temp,len(str_temp) - 2)
              if right(str_temp,2) = vbcrlf then str_temp = left(str_temp,len(str_temp) - 2)
              if left(str_temp,1) = "%" then
                str_temp = right(str_temp,len(str_temp) - 1)
                if left(str_temp,1) = "=" then
                  str_temp = right(str_temp,len(str_temp) - 1)
                  str_temp = "response.write " & str_temp
                end if
              else
                if str_temp <> "" then
				  include_vars_count = include_vars_count + 1
                  include_vars.add include_vars_count, str_temp
                  str_temp = "response.write include_vars.item(" & include_vars_count & ")" 
                end if
              end if
              if right(str_temp,2) <> vbcrlf then str_temp = str_temp
              arr_temp(i) = str_temp
            next
            str_source = join(arr_temp,vbcrlf)
          end if
        else
          if str_source <> "" then
            include_vars.add "var", str_source
            str_source = "response.write include_vars.item(""var"")"
          end if
        end if
      end if
    end sub

    private function processincludes(tmp_source, curdir, curdepth)
      dim int_start, str_path, str_mid, str_temp, localdir
	  
	  if (curdepth < 20) then ' Maximum allowable depth.  Just in case we get two files including each other
	  
		  localdir = left(curdir, len(curdir)-len(objfschk.GetFileName(curdir)))
	      tmp_source = replace(tmp_source,"<!-- #","<!--#")
	      int_start = instr(tmp_source,"<!--#include")
	      str_mid = lcase(getbetween(tmp_source,"<!--#include","-->"))
	
	      do until int_start = 0
	        str_mid = lcase(getbetween(tmp_source,"<!--#include","-->"))
			
			if (str_mid <> "") then int_start = 1
	        if int_start >  0 then
	          str_method = lcase(trim(getbetween(str_mid," ","=")))
	          str_temp = lcase(getbetween(str_mid,chr(34),chr(34)))
	          str_temp = trim(str_temp)
			  
			  if (str_method = "file") then
			  	newdir = objfschk.BuildPath(localdir,replace(str_temp,"/","\"))
	
				str_path = processincludes(readfile(newdir), newdir, curdepth+1)
				tmp_source = replace(tmp_source,"<!--#include" & str_mid & "-->",str_path & vbcrlf)
				
			  elseif (str_method = "virtual") then	
			  
			  	newdir = server.mappath(str_temp)
	
				str_path = processincludes(readfile(newdir), newdir)
				tmp_source = replace(tmp_source,"<!--#include" & str_mid & "-->",str_path & vbcrlf)
			  else	
				tmp_source = replace(tmp_source,"<!--#include" & str_mid & "-->","" & vbcrlf)
			  end if
			  
	        end if
			
	        int_start = instr(tmp_source,"<!--#include")
	      loop

		  processincludes = tmp_source
	  else	  
		  processincludes = ""
	  end if
	  
    end function

    private sub formatcode(str_code)
      dim i, arr_temp, int_len
      str_code = replace(str_code,vbcrlf & vbcrlf,vbcrlf)
      if left(str_code,2) = vbcrlf then str_code = right(str_code,len(str_code) - 2)
      str_code = trim(str_code)
      if instr(str_code,vbcrlf) > 0 then
        arr_temp = split(str_code,vbcrlf)
        for i = 0 to ubound(arr_temp)
          arr_temp(i) = ltrim(arr_temp(i))
          if arr_temp(i) <> "" then arr_temp(i) = arr_temp(i) & vbcrlf
        next
        str_code = join(arr_temp,"")
        arr_temp = vbnull
      end if
    end sub

    private function readfile(str_path)
      dim objfile
      if str_path <> "" then
        if instr(str_path,":") = 0 then str_path = server.mappath(str_path)
        if objfschk.fileexists(str_path) then
          set objfile = objfschk.opentextfile(str_path, 1, false)
          if err.number = 0 then
		  	if (not objfile.AtEndOfStream) then
	            readfile = objfile.readall

				' Begin big elaborate mess of code designed to safely remove vbscript comments
				regFltr.Global = True
				regFltr.IgnoreCase = True
				regFltr.Pattern = "<%[^=](.|\n)*?%" & ">"
				
				regFltr2.Global = True
				regFltr2.IgnoreCase = True
				regFltr2.Pattern = """.*?"""
				
				Set Matches = regFltr.Execute(readfile) 

				pEnd = 0
				pStart = 1
				str_temp_new = ""
				For Each Match in Matches

					pEnd = Match.FirstIndex + 1
					if (pEnd <> pStart) then
						str_temp_new = str_temp_new & Mid(readfile, pStart, pEnd - pStart)
						pStart = pEnd
					end if			
					
					Set Matches2 = regFltr2.Execute(Match.Value) 
					
					pEnd2 = 0
					pStart2 = 1
					cpystr = ""
					
					For Each Match2 in Matches2
						pEnd2 = Match2.FirstIndex + 1
						if (pEnd2 <> pStart2) then
							cpystr = cpystr & Mid(Match.Value, pStart2, pEnd2 - pStart2)
							pStart2 = pEnd2
						end if			
						cpystr = cpystr & replace(Match2.value,"'","æ")
						pEnd2 = pStart2 + Match2.length
						pStart2 = pEnd2
					next

					if (pEnd2 < len(Match.Value)) then
						pEnd2 = len(Match.Value)+1
						cpystr = cpystr & Mid(Match.Value, pStart2, pEnd2 - pStart2)
					end if						
					
					Set Matches2 = nothing
					
				    regFltr.Pattern = "'.*?\n"
					str_temp_new = str_temp_new & regFltr.Replace(cpystr,vbcr)
					
					pEnd = pStart + Match.length
					pStart = pEnd
				Next
				
				if (pEnd < len(readfile)) then
					pEnd = len(readfile)+1
					str_temp_new = str_temp_new & Mid(readfile, pStart, pEnd - pStart)
				end if						
				
				readfile = replace(str_temp_new,"æ","'")
				
			else
				readfile = ""
			end if
            objfile.close
          end if
          set objfile = nothing
        end if
      end if
    end function

    private function getbetween(strdata, strstart, strend)
      dim lngstart, lngend
      lngstart = instr(strdata, strstart) + len(strstart)
      if (lngstart <> 0) then
        lngend = instr(lngstart, strdata, strend)
        if (lngend <> 0) then
          getbetween = mid(strdata, lngstart, lngend - lngstart)
        end if
      end if
    end function

  end class

%>